home *** CD-ROM | disk | FTP | other *** search
/ BMUG Revelations / BMUG Revelations.toast / Programming / Programming Languages / Yerk 3.64 / Supplement / Demo Folder / grDemo < prev    next >
Encoding:
Text File  |  1993-06-25  |  6.8 KB  |  187 lines  |  [TEXT/MACA]
  1. \ grdemo - source for Curves, a simple Yerk application
  2. \ 11/04/84  CBD Version 1
  3. \ 12/21/84  cbd simplified design based on new control classes
  4. \  2/18/84  cbd final for release 1.0
  5.  
  6. \ Define a class of special vertical scroll bars that 
  7. \ always show digital values for their thumb settings.
  8. :CLASS VSCtl  <Super vScroll
  9.  
  10.     Rect    readOut     \ visible rect around readout value
  11.     Rect    viewReadOut \ view rect for readout number is inset by 4 pixels.
  12.  
  13.     \ update the digital readout of the thumb value 
  14.     :M  DISPLAY:  GetTopX: viewReadOut getBotY: viewReadOut 1- gotoxy
  15.             -curs clear: viewReadOut  Get: super  3 .R  ;M
  16.  
  17.     \ redraw the readOut rect and display the value inside
  18.     :M  DRAW:  draw: readout  display: self   ;M
  19.  
  20.     \ ( val -- )  put new thumb value, draw the readout number
  21.     :M  PUT:  put: super  display: self  ;M
  22.  
  23.     \ Build new scroll bar - window must be created 1st
  24.     :M  NEW: { left top len  wind -- } left top len wind 
  25.             New: Super  1 tmode 9 tsize 1 tfont
  26.             \ calculate the coordinates for the readOut rectangles 
  27.             left 4-  top len + 4+ dup -> len        
  28.             left 20 + len 20 + put: readOut draw: readOut
  29.             get: readOut put: viewReadOut 3 3 inset: viewReadOut  ;M
  30.  
  31. ;CLASS
  32.  
  33. \ now, build three instances of class vSctl. These will be the
  34. \ three vertical scroll bars for Curves.
  35.    VSctl Vs1      \ three scroll bars for control of 
  36.    VSctl Vs2      \ graphics parameters by the user
  37.    VSctl Vs3       
  38.  
  39. \ assign constants to the window corners, so that we can change
  40. \ the size of the window and the length of the scroll bars will be
  41. \ adjusted automatically.  These constants relate to the global 
  42. \ coordinates of the Macintosh screen.
  43. 40  Value gwL    
  44. 60  Value gwT
  45. 470 Value gwR
  46. 290 Value gwB
  47. gwB gwT - 80 - Value vsLen  \ len of scroll bars 
  48.  
  49.  
  50. \ Define a subclass of CtlWind containing a drawing pane.
  51. \ The window will be a RoundDoc, draggable, non-growable.
  52. :CLASS grWind  <Super CtlWind 
  53.  
  54.     Rect    thePane \ this is where we'll draw the graphics
  55.  
  56.     \ Create a new grWind with rounded corners and title passed by caller
  57.     :M  NEW: { taddr tlen -- }  gwL gwT gwR gwB put: tempRect
  58.             tempRect tAddr tLen rndWind
  59.             true False  New: super 
  60.             grayRgn true setDrag: self ;M     \ visible, no close box
  61.  
  62.     \ handle an update event for this window
  63.     :M  DRAW: set: self    draw: vs1 draw: vs2  draw: vs3   
  64.             (abs)  call BeginUpdate  (abs) call drawControls
  65.             clear: thePane draw: thePane
  66.             watchCurs                     \ show the watch cursor while drawing
  67.             clip: thePane  exec: draw    \ clip to the pane and draw
  68.             arrowCurs
  69.             (abs)  call EndUpdate 
  70.             clip: contRect      \ clip back to entire window
  71.             \ cause the scroll bars to draw their readouts
  72.     ;M
  73.  
  74.     \ set defaults appropriate to this class
  75.     :M  CLASSINIT:   ClassInit: super    \ set window class defaults
  76.             4 15 320 220 put: thePane ;M
  77.  
  78. ;CLASS
  79.  
  80. \ instantiate grWind to create the Curves demo window.
  81. grWind dwind
  82.  
  83. scon dTitle "Yerk Curves"    \ title for dWind
  84.  
  85. \ set the current GrafPort to fWind so that we can see what's 
  86. \ going on during the compilation.
  87. set: fwind
  88.  
  89. \ ( -- p1 p2 p3 ) fetch the drawing parameters from the three scroll bars.
  90. : @dParms  get: vs1  get: vs2  get: vs3  ;
  91.  
  92. \ ( -- ) define the 4 draw: handlers, 1 for each type of drawing. 
  93. : Spiral  @dparms  PutRange: Bic    spiral: bic ;
  94. : spin    @dparms  putRange: anna   spin: anna  ;
  95. : Lj      @dparms  putRange: bic    lj: bic ;
  96. : dragon  @dparms   putRange: bic  home: bic 
  97.           get: vs1  dragon: bic  ;  \ dragon requires start val on stack 
  98.  
  99. \ store new parameter ranges for the three scroll bars.
  100. : !ranges  { max1 max2 max3 -- }  
  101.      1 max1 putRange: vs1  1 max2 putRange: vs2  
  102.      1 max3 putRange: vs3  ;
  103.      
  104. \ send the New: message to the window and scroll bars.
  105. \ this creates them within the Toolbox and displays them.
  106. : newObjs  close: fWind  dTitle New: dWind   
  107.       340 40 vsLen  dWind  new: vs1  
  108.       370 40 vsLen  dWind  new: vs2 
  109.       400 40 vsLen  dWind  new: vs3    ; 
  110.  
  111.  
  112. scon ab1 "Curves was written in Yerk"
  113. scon ab2 "by Charles B. Duff" 
  114. scon ab3 "of Kriya Systems, Inc."
  115.  
  116. : about  0 tfont 0 tmode 12 tsize
  117.     8 40 Gotoxy ab1 type 
  118.     cr ab2 type cr ab3 type
  119.     initFont  ;    
  120.  
  121. \ tell the two Pen objects where to center themselves 
  122. \ when they do a Home: operation. Because these values will be retained
  123. \ in the pen objects when we do a SAVE, they can be set
  124. \ at compile time.
  125. 150 120 center: bic
  126. 150 120 center: anna
  127.  
  128. \ Define the actions for the various control parts.
  129. \ each action handler executes a deferred get: on the object whose
  130. \ address is on the method stack. Since the handler was called from
  131. \ the Exec: method of a vScroll object, the scroll bar's address 
  132. \ will be on the top of the mstack.  The handler then modifies the 
  133. \ value of the thumb, and causes thePane in dWind to be redrawn
  134. \ be adding its area to the current region.
  135.  
  136. : doThumb   update: dWind  ;
  137. : doPgUp    get: myCtl 10 - put: myCtl update: dWind  ; 
  138. : doPgDn    get: myCtl 10 + put: myCtl update: dWind  ; 
  139. : doLnUp    get: myCtl 1-   put: myCtl update: dWind  ; 
  140. : doLnDn    get: myCtl 1+   put: myCtl update: dWind  ; 
  141.  
  142. 'c lj setdraw: dwind
  143.  
  144. 5 'cfas  doLnUp doLnDn doPgUp doPgDn doThumb  actions: vs1
  145. 5 'cfas  doLnUp doLnDn doPgUp doPgDn doThumb  actions: vs2
  146. 5 'cfas  doLnUp doLnDn doPgUp doPgDn doThumb  actions: vs3
  147.  
  148. \ define the menu for this application.  AppleMen is already there.
  149. 5 Menu Grafmen
  150.  
  151. \ Define the menu handler words. Each one sets a new handler
  152. \ for dWind's DRAW method, and then sets appropriate ranges and 
  153. \ titles for the scroll bars, and causes an update event.
  154. ( do Lissajous curves )
  155. : doLiss  mitem checkOne: theMenu 'c lj setdraw: dwind 200 200 179 !ranges update: dwind ;
  156.  
  157. ( do Spirals )
  158. : doSpiral  mitem checkOne: theMenu 'c spiral setdraw: dwind 10 20 179 !ranges update: dwind ;
  159.  
  160. ( do spinPolys )
  161. : doSpin  mitem checkOne: theMenu 'c spin setdraw: dwind 8 10 179 !ranges update: dwind ;
  162.  
  163. ( do Dragon curves )
  164. : doDrag  mitem checkOne: theMenu 'c dragon setdraw: dwind 11 12 179 !ranges update: dwind ; 
  165.  
  166. ( set max reps in bic )
  167. : setReps 300 putMax: bic 100 putMax: anna ;
  168.  
  169. : sayonara  bye  ;
  170.  
  171. \ fill menus with handlers
  172.  2 'cfas about null                                1 put: appleMen
  173.  5 'cfas doLiss doSpiral doSpin doDrag bye      128 put: grafMen
  174.  
  175. \ get the new menubar from the resource file "demo.rsrc" and start
  176. \  with 'lissajous' draws, so check the first menu item
  177. : getGRMenu applemen grafMen 2 init: menubar 1 check: grafMen ;
  178.  
  179. \ startup word for the turtle graphics demo
  180. : dStart  " demo.rsrc" openresfile 
  181.     getGRMenu newobjs  
  182.     150 120 center: bic  150 120 center: anna  
  183.     setReps
  184.     200 200 179 !ranges update: dwind     \ don't call 'doliss' because mitem and themenu aren't set
  185.     -echo -curs
  186.     BEGIN  key drop AGAIN    ;  \ just loop and listen to events
  187.